home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / Windows_Re190765712005.psc / Registry Fixer / cRegSearch.cls next >
Text File  |  2005-06-30  |  11KB  |  293 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cRegSearch"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. 'Sorry, this isn't my registry class so I can't really make any comments, except for obvious ones
  17.  
  18.  
  19. ' Class for searching Windows Registry
  20. '
  21. ' Written by Arkadiy Olovyannikov (ark@fesma.ru)
  22. ' Copyright 2001 by Arkadiy Olovyannikov
  23. '
  24. ' This software is FREEWARE. You may use it as you see fit for
  25. ' your own projects but you may not re-sell the original or the
  26. ' source code.
  27. '
  28. ' No warranty express or implied, is given as to the use of this
  29. ' program. Use at your own risk.
  30.  
  31. Option Explicit
  32.  
  33. Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  34. Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
  35. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  36. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
  37.  
  38. Enum ROOT_KEYS
  39.     HKEY_ALL = &H0&
  40.     HKEY_CLASSES_ROOT = &H80000000
  41.     HKEY_CURRENT_CONFIG = &H80000005
  42.     HKEY_CURRENT_USER = &H80000001
  43.     HKEY_DYN_DATA = &H80000006
  44.     HKEY_LOCAL_MACHINE = &H80000002
  45.     HKEY_PERFORMANCE_DATA = &H80000004
  46.     HKEY_USERS = &H80000003
  47. End Enum
  48.  
  49. Enum SEARCH_FLAGS
  50.     KEY_NAME = 0
  51.     VALUE_NAME = 1
  52.     VALUE_VALUE = 2
  53.     WHOLE_STRING = 4
  54. End Enum
  55.  
  56. Enum FOUND_WHERE
  57.     FOUND_IN_KEY_NAME
  58.     FOUND_IN_VALUE_NAME
  59.     FOUND_IN_VALUE_VALUE
  60. End Enum
  61.  
  62. Private Const STANDARD_RIGHTS_ALL = &H1F0000
  63. Private Const KEY_QUERY_VALUE = &H1
  64. Private Const KEY_SET_VALUE = &H2
  65. Private Const KEY_CREATE_SUB_KEY = &H4
  66. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  67. Private Const KEY_NOTIFY = &H10
  68. Private Const KEY_CREATE_LINK = &H20
  69. Private Const SYNCHRONIZE = &H100000
  70. Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
  71. Const KEY_READ = &H20019    ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
  72. ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
  73. ' SYNCHRONIZE))
  74.  
  75. Private Const ERROR_SUCCESS = 0&
  76. Private Const ERR_MORE_DATA = 234&
  77. Private Const ERROR_NO_MORE_ITEMS = 259&
  78.  
  79. Private Const REG_NONE = 0
  80. Private Const REG_SZ = 1
  81. Private Const REG_EXPAND_SZ = 2
  82. Private Const REG_BINARY = 3
  83. Private Const REG_DWORD = 4
  84. Private Const REG_DWORD_LITTLE_ENDIAN = 4
  85. Private Const REG_DWORD_BIG_ENDIAN = 5
  86. Private Const REG_LINK = 6
  87. Private Const REG_MULTI_SZ = 7
  88. Private Const REG_RESOURCE_LIST = 8
  89. Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
  90. Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10
  91.  
  92. Private Const MAX_KEY_SIZE = 260
  93. Private Const MAX_VALUE_SIZE = 4096
  94.  
  95. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)
  96.  
  97. Public Event SearchFound(ByVal sRootKey As String, ByVal sKey As String, ByVal sValue As Variant, ByVal lFound As FOUND_WHERE)
  98. Public Event SearchFinished(ByVal lReason As Long)
  99. Public Event SearchKeyChanged(ByVal sFullKeyName As String)
  100.  
  101. Private mvarRootKey As ROOT_KEYS
  102. Private mvarSearchFlags As SEARCH_FLAGS
  103. Private mvarSearchString As String
  104. Private mvarSubKey As String
  105.  
  106. Dim lStopSearch As Long
  107.  
  108. Public Property Let SubKey(ByVal vData As String)
  109.     mvarSubKey = vData
  110. End Property
  111.  
  112. Public Property Let SearchString(ByVal vData As String)
  113.     mvarSearchString = vData
  114. End Property
  115.  
  116. Public Property Let SearchFlags(ByVal vData As SEARCH_FLAGS)
  117.     mvarSearchFlags = vData
  118. End Property
  119.  
  120. Public Property Let RootKey(ByVal vData As ROOT_KEYS)
  121.     mvarRootKey = vData
  122. End Property
  123.  
  124. Public Sub DoSearch()
  125.     If mvarRootKey <> HKEY_ALL Then
  126.         If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Or (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
  127.             Call EnumRegValues(mvarRootKey, mvarSubKey)
  128.         End If
  129.         Call EnumRegKeys(mvarRootKey, mvarSubKey)
  130.     Else
  131.         Call EnumRegKeys(HKEY_CLASSES_ROOT, mvarSubKey)
  132.         If lStopSearch Then GoTo Search_Terminated
  133.         Call EnumRegKeys(HKEY_CURRENT_USER, mvarSubKey)
  134.         If lStopSearch Then GoTo Search_Terminated
  135.         Call EnumRegKeys(HKEY_LOCAL_MACHINE, mvarSubKey)
  136.         If lStopSearch Then GoTo Search_Terminated
  137.         Call EnumRegKeys(HKEY_USERS, mvarSubKey)
  138.         If lStopSearch Then GoTo Search_Terminated
  139.         Call EnumRegKeys(HKEY_PERFORMANCE_DATA, mvarSubKey)
  140.         If lStopSearch Then GoTo Search_Terminated
  141.         Call EnumRegKeys(HKEY_CURRENT_CONFIG, mvarSubKey)
  142.         If lStopSearch Then GoTo Search_Terminated
  143.         Call EnumRegKeys(HKEY_DYN_DATA, mvarSubKey)
  144.     End If
  145. Search_Terminated:
  146.     RaiseEvent SearchFinished(lStopSearch)
  147.     lStopSearch = 0
  148. End Sub
  149.  
  150. Public Sub StopSearch()
  151.     lStopSearch = 1
  152. End Sub
  153.  
  154. Private Sub EnumRegKeys(ByVal lKeyRoot As Long, ByVal sSubKey As String)
  155.     Dim curidx As Long
  156.     Dim KeyName As String
  157.     Dim hKey As Long
  158.     Dim sTemp As String
  159.     If lStopSearch Then Exit Sub
  160.     On Error GoTo ErrEnum
  161.     If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
  162.     Do
  163.         DoEvents
  164.         KeyName = Space$(MAX_KEY_SIZE)
  165.         If RegEnumKey(hKey, curidx, KeyName, MAX_KEY_SIZE) <> ERROR_SUCCESS Then Exit Do
  166.         curidx = curidx + 1
  167.         KeyName = TrimNull(KeyName)
  168.         If sSubKey <> "" Then
  169.             sTemp = sSubKey & "\" & KeyName
  170.         Else
  171.             sTemp = KeyName
  172.         End If
  173.         '****************************************************
  174.         'This event is used for showing currently viewing key.
  175.         'Usually you don't need this.
  176.         'To increase performance, remove this event
  177.         If lStopSearch = 0 Then RaiseEvent SearchKeyChanged(RootKeyName(lKeyRoot) & "\" & sTemp)
  178.         '****************************************************
  179.         If (mvarSearchFlags And KEY_NAME) = KEY_NAME Then
  180.             If CheckMatching(KeyName) Then
  181.                 RaiseEvent SearchFound(RootKeyName(lKeyRoot), sTemp, "*", FOUND_IN_KEY_NAME)
  182.             End If
  183.         End If
  184.         If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Or (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
  185.             Call EnumRegValues(lKeyRoot, sTemp)
  186.         End If
  187.         Call EnumRegKeys(lKeyRoot, sTemp)
  188.     Loop
  189. ErrEnum:
  190.     If Err Then lStopSearch = Err
  191.     RegCloseKey hKey
  192. End Sub
  193.  
  194. Private Sub EnumRegValues(ByVal lKeyRoot As Long, ByVal sSubKey As String)
  195.     Dim curidx As Long, ValueName As String, ValueValue As String
  196.     Dim hKey As Long
  197.     Dim lType As Long
  198.     Dim arrData() As Byte
  199.     Dim cbDataSize As Long
  200.     If lStopSearch Then Exit Sub
  201.     On Error GoTo ErrEnum
  202.     If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
  203.     Do
  204.         ValueName = String(MAX_KEY_SIZE, 0)
  205.         cbDataSize = MAX_VALUE_SIZE
  206.         ReDim arrData(cbDataSize - 1)
  207.         If RegEnumValue(hKey, curidx, ValueName, MAX_KEY_SIZE, ByVal 0&, lType, arrData(0), cbDataSize) <> ERROR_SUCCESS Then Exit Do
  208.         If cbDataSize < 1 Then cbDataSize = 1
  209.         ReDim Preserve arrData(cbDataSize - 1)
  210.         ValueName = TrimNull(ValueName)
  211.         If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Then
  212.             If CheckMatching(ValueName) Then RaiseEvent SearchFound(RootKeyName(lKeyRoot), sSubKey & "\" & ValueName, GetRegData(lType, arrData), FOUND_IN_VALUE_NAME)
  213.         End If
  214.         If (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
  215.             ValueValue = TrimNull(GetRegData(lType, arrData))
  216.             If CheckMatching(ValueValue) Then
  217.                 RaiseEvent SearchFound(RootKeyName(lKeyRoot), sSubKey & "\" & ValueName, ValueValue, FOUND_IN_VALUE_VALUE)
  218.             End If
  219.         End If
  220.         curidx = curidx + 1
  221.     Loop
  222. ErrEnum:
  223.     If Err Then lStopSearch = Err
  224.     RegCloseKey hKey
  225. End Sub
  226.  
  227. Private Function TrimNull(startstr As String) As String
  228.     Dim pos As Integer
  229.     pos = InStr(startstr, Chr$(0))
  230.     If pos Then
  231.         TrimNull = Left$(startstr, pos - 1)
  232.         Exit Function
  233.     End If
  234.     TrimNull = startstr
  235. End Function
  236.  
  237. Private Function CheckMatching(ByVal sCheck As String) As Boolean
  238.     If (mvarSearchFlags And WHOLE_STRING) = WHOLE_STRING Then
  239.         CheckMatching = (UCase(sCheck) = UCase(mvarSearchString))
  240.     Else
  241.         CheckMatching = InStr(1, sCheck, mvarSearchString, vbTextCompare)
  242.     End If
  243. End Function
  244.  
  245. Private Function GetRegData(ByVal lType As Long, abData() As Byte) As String
  246.     Dim lData As Long, i As Long
  247.     Dim sTemp As String
  248.     sTemp = ""
  249.     Select Case lType
  250.     Case REG_SZ, REG_MULTI_SZ
  251.         GetRegData = TrimNull(StrConv(abData, vbUnicode))
  252.     Case REG_DWORD
  253.         CopyMem lData, abData(0), 4&
  254.         GetRegData = "0x" & Format(Hex(lData), "00000000") & "(" & lData & ")"
  255.     Case REG_BINARY
  256.         For i = 0 To UBound(abData)
  257.             sTemp = sTemp & Right("00" & Hex(abData(i)), 2) & " "
  258.         Next i
  259.         GetRegData = Left(sTemp, Len(sTemp) - 1)
  260.     Case Else
  261.         GetRegData = "Temporarily unsupported"
  262.     End Select
  263. End Function
  264.  
  265. Private Function RootKeyName(lKey As Long) As String
  266.     Select Case lKey
  267.     Case HKEY_CLASSES_ROOT
  268.         RootKeyName = "HKEY_CLASSES_ROOT"
  269.     Case HKEY_CURRENT_USER
  270.         RootKeyName = "HKEY_CURRENT_USER"
  271.     Case HKEY_LOCAL_MACHINE
  272.         RootKeyName = "HKEY_LOCAL_MACHINE"
  273.     Case HKEY_USERS
  274.         RootKeyName = "HKEY_USERS"
  275.     Case HKEY_PERFORMANCE_DATA
  276.         RootKeyName = "HKEY_PERFORMANCE_DATA"
  277.     Case HKEY_CURRENT_CONFIG
  278.         RootKeyName = "HKEY_CURRENT_CONFIG"
  279.     Case HKEY_DYN_DATA
  280.         RootKeyName = "HKEY_DYN_DATA"
  281.     End Select
  282. End Function
  283.  
  284. Private Sub Class_Initialize()
  285.     mvarRootKey = HKEY_ALL
  286.     mvarSubKey = ""
  287.     mvarSearchString = ""
  288. End Sub
  289.  
  290. Private Sub Class_Terminate()
  291.     lStopSearch = 1
  292. End Sub
  293.